home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Fritz: All Fritz
/
All Fritz.zip
/
All Fritz
/
FILES
/
PROGASIC
/
BASFILES.LZH
/
QBTXKYSB.BAS
< prev
next >
Wrap
BASIC Source File
|
1988-09-10
|
9KB
|
385 lines
'$INCLUDE:'QBTOOLS.INC'
'' '$INCLUDE: '\include\qbtools2.inc'
'' '$INCLUDE: '\include\qbt2indx.inc'
'' '-------------------------Standard Include Merge Section-------------------
DEFSNG A-Z
SUB KeySelectBox (Ch AS KeySelection, Opt$, IxNum%, ky$, Mrec%, Xnm$(), Xk$(), Xh%(), Sc%) STATIC
CONST CORRUPT = "Error:Internal, KeySelectBox Index Corrupt"
IF Xh%(IxNum%, 2) = 0 THEN ' No keys in the index
Opt$ = ""
Mr% = 0
Sc% = 0
Ch.Echoice = -1 ' No Keys in the Index
EXIT SUB
END IF ' xh%(IxNum%,2%)=0%
REDIM Dg$(2), d$(10)
REDIM SvScr%(2000)
Tx% = Ch.Row
Ty% = Ch.Col
height% = Ch.Lin
REDIM Disp$(height%), Mrtemp%(height%), Sctemp%(height%)
ExitOp% = Ch.Exi
d$(1) = Ch.o1
d$(2) = Ch.o2
d$(3) = Ch.o3
d$(4) = Ch.o4
d$(5) = Ch.o5
d$(6) = Ch.o6
d$(7) = Ch.o7
d$(8) = Ch.o8
d$(9) = Ch.o9
d$(10) = Ch.o10
Ex$ = "ESC = Exit ENTER = Select ? = Find"
Dwidth% = Maximum%(Ch.KeyLen, LEN(Ex$))
Dg$(1) = Ch.Init1
Dg$(2) = Ch.Init2
Trim Dg$(1)
Trim Dg$(2)
FOR j% = 1 TO 10
Trim d$(j%)
Dwidth% = Maximum%(Dwidth%, LEN(d$(j%)))
NEXT j%
Dwidth2% = Dwidth%
Dwidth% = Dwidth% + 2
TotalHeight% = height% + 2 ' Scroll box height (plus borders)
TotalHeight% = TotalHeight% + ExitOp% + 2 ' Quit Box + ESC + Line
CheckHeight% = TotalHeight% + Tx% - 1 ' Check the complete height
IF CheckHeight% > 25 THEN
Opt$ = ""
Mr% = 0
Sc% = 0
EXIT SUB
END IF
CheckWidth% = Dwidth% + Ty% - 1
IF CheckWith% > 80 THEN
Opt$ = ""
Mr% = 0
Sc% = 0
EXIT SUB
END IF
SaveScreen SvScr%(1)
DrawBox Tx%, Ty%, Dwidth%, TotalHeight%, Ch.Btype, Ch.Ff, Ch.Fb, 1, Ch.Nf, Ch.Nb
Crow% = Tx% + height% + 1
Ccol% = Ty% + 1
Acc$ = STRING$(Dwidth% - 2, 196)
Att% = Attributes%(Ch.Ff, Ch.Fb, 0, 0)
Att1% = Attributes%(Ch.Nf, Ch.Nb, 0, 0)
Att2% = Attributes%(Ch.Sf, Ch.Sb, 0, 0)
ColorPrint Acc$, Crow%, Ccol%, Att%
Crow% = Tx% + height% + 2
ColorPrint Ex$, Crow%, Ccol%, Att%
FOR j% = 1 TO Ch.Exi
Acc$ = d$(j%)
Crow% = Tx% + height% + j% + 2
ColorPrint Acc$, Crow%, Ccol%, Att1%
NEXT j%
GOSUB HomeKeys ' Display from the top
GOSUB DisplayKeys ' Display the keys
Curs% = 1 ' Cursor Row
DO ' Controlling Loop
Acc$ = Disp$(Curs%)
IF LEN(Acc$) < Dwidth2% - 2 THEN
Acc$ = Acc$ + STRING$(Dwidth2% - LEN(Acc$), 32)
END IF
Crow% = Curs% + Tx%
ColorPrint Acc$, Crow%, Ccol%, Att2%
Kbd$ = ""
WHILE Kbd$ = ""
Kbd$ = INKEY$
WEND
IF LEN(Kbd$) = 1 THEN
Opt% = ASC(Kbd$)
SELECT CASE Opt%
CASE 63 ' ? Question Mark
DialogBox Dg$(), 1, 1, Ch.KeyLen, Ch.Ff, Ch.Fb, Ch.Nf, Ch.Nb, 1, Ans$, Exk%
ky$ = Ans$
IndexFind IxNum%, ky$, Mrec%, Xnm$(), Xk$(), Xh%(), Sc%
IF Sc% THEN
Disp$(1) = ky$
Mrtemp%(1) = ABS(Mrec%)
Sctemp%(1) = Sc%
ELSE
PRINT CORRUPT
END
END IF
PmRec% = Mrec%
GOSUB GetNextTen
Curs% = 1
GOSUB DisplayKeys
CASE 27 ' Simple ESCAPE
ky$ = ""
Mrec% = 0
Sc% = 0
Ch.Echoice = 11 ' Flag for ESC
EXIT DO
CASE 13 ' RETURN
ky$ = Disp$(Curs%)
Mrec% = Mrtemp%(Curs%)
Sc% = Sctemp%(Curs%)
Ch.Echoice = 12 ' Flag for RETURN
EXIT DO
CASE ELSE
END SELECT
END IF
IF LEN(Kbd$) = 2 THEN
Opt% = ASC(RIGHT$(Kbd$, 1))
SELECT CASE Opt%
CASE 59 TO 68
Fkey% = Opt% - 58
IF Ch.Exi >= Fkey% THEN
Ch.Echoice = Fkey%
ky$ = Disp$(Curs%)
Mrec% = Mrtemp%(Curs%)
Sc% = Sctemp%(Curs%)
EXIT DO
END IF
CASE 71 ' Home
Curs% = 1
GOSUB HomeKeys
GOSUB DisplayKeys
CASE 79 ' End
GOSUB EndKeys
GOSUB DisplayKeys
Curs% = height% - top% + 1
CASE 80 ' Down Arrow
Curs% = Curs% + 1
IF Curs% > height% THEN
Curs% = Curs% - 1
IF Sctemp%(height%) <> 0 THEN
ky$ = Disp$(height%)
Mrec% = Mrtemp%(height%)
Sc% = Sctemp%(height%)
Psc% = Sc%
IndexNext IxNum%, ky$, Mrec%, Xnm$(), Xk$(), Xh%(), Sc%
IF Sc% <> 0 THEN
IF Psc% <> Sc% THEN
FOR j% = 1 TO height% - 1
Sctemp%(j%) = Sctemp%(j% + 1)
Mrtemp%(j%) = Mrtemp%(j% + 1)
Disp$(j%) = Disp$(j% + 1)
NEXT j%
Disp$(height%) = ky$
Mrtemp%(height%) = Mrec%
Sctemp%(height%) = Sc%
END IF
END IF
END IF
ELSE
IF Sctemp%(Curs%) = 0 THEN
Curs% = Curs% - 1
END IF
END IF
GOSUB DisplayKeys
CASE 72 ' Up Arrow
Curs% = Curs% - 1
IF Curs% < 1 THEN
Curs% = Curs% + 1
IF Sctemp%(1) <> 0 THEN
ky$ = Disp$(1)
Mrec% = Mrtemp%(1)
Sc% = Sctemp%(1)
Psc% = Sc%
IndexPrevious IxNum%, ky$, Mrec%, Xnm$(), Xk$(), Xh%(), Sc%
IF Sc% <> 0 THEN
IF Psc% <> Sc% THEN
FOR j% = height% TO 2 STEP -1
Sctemp%(j%) = Sctemp%(j% - 1)
Mrtemp%(j%) = Mrtemp%(j% - 1)
Disp$(j%) = Disp$(j% - 1)
NEXT j%
Disp$(1) = ky$
Mrtemp%(1) = Mrec%
Sctemp%(1) = Sc%
END IF
END IF
END IF
ELSE
IF Sctemp%(Curs%) = 0 THEN
Curs% = Curs% + 1
END IF
END IF
GOSUB DisplayKeys
CASE ELSE
END SELECT
END IF
LOOP
RestoreScreen SvScr%(1)
EXIT SUB
DisplayKeys:
FOR j% = 1 TO height%
Acc$ = Disp$(j%)
IF LEN(Acc$) < Dwidth2% THEN
Acc$ = Acc$ + STRING$(Dwidth2% - LEN(Acc$), 32)
END IF
Crow% = Tx% + j%
ColorPrint Acc$, Crow%, Ccol%, Att%
NEXT j%
RETURN
HomeKeys:
FOR j% = 1 TO 2
Mrtemp%(j%) = 0
Sctemp%(j%) = 0
PmRec% = 0
Disp$(j%) = STRING$(Ch.KeyLen, 32)
NEXT j%
IndexFindFirst IxNum%, ky$, Mrec%, Xnm$(), Xk$(), Xh%(), Sc%
IF Sc% THEN
Disp$(1) = ky$
Mrtemp%(1) = Mrec%
Sctemp%(1) = Sc%
ELSE
PRINT CORRUPT
END
END IF
PmRec% = Mrec%
Psc% = Sc%
Curs% = 1
GetNextTen:
FOR j% = 2 TO height%
Mrtemp%(j%) = 0
Sctemp%(j%) = 0
Disp$(j%) = STRING$(Ch.KeyLen, 32)
NEXT j%
FOR j% = 2 TO height%
IndexNext IxNum%, ky$, Mrec%, Xnm$(), Xk$(), Xh%(), Sc%
IF Sc% > 0 THEN
IF PmRec% = Mrec% AND Sc% = Psc% THEN
EXIT FOR
ELSE
Disp$(j%) = ky$
Mrtemp%(j%) = Mrec%
Sctemp%(j%) = Sc%
PmRec% = Mrec%
Psc% = Sc%
END IF
ELSE
EXIT FOR
END IF
NEXT j%
Ah% = j% - 1 ' Height%
RETURN
EndKeys:
FOR j% = height% TO height%
Mrtemp%(j%) = 0
Sctemp%(j%) = 0
Disp$(j%) = STRING$(Ch.KeyLen, 32)
NEXT j%
IndexFindLast IxNum%, ky$, Mrec%, Xnm$(), Xk$(), Xh%(), Sc%
IF Sc% THEN
Disp$(height%) = ky$
Mrtemp%(height%) = Mrec%
Sctemp%(height%) = Sc%
ELSE
PRINT CORRUPT
END
END IF
PmRec% = Mrec%
Psc% = Sc%
Curs% = 1
GetPreviousTen:
FOR j% = 1 TO height% - 1
Mrtemp%(j%) = 0
Sctemp%(j%) = 0
Disp$(j%) = STRING$(Ch.KeyLen, 32)
NEXT j%
top% = 1
FOR j% = height% - 1 TO 1 STEP -1
Disp$(j%) = STRING$(Ch.KeyLen, 32)
IndexPrevious IxNum%, ky$, Mrec%, Xnm$(), Xk$(), Xh%(), Sc%
IF Sc% > 0 THEN
IF Psc% = Sc% AND PmRec% = Mrec% THEN
EXIT FOR
ELSE
Disp$(j%) = ky$
Mrtemp%(j%) = Mrec%
Sctemp%(j%) = Sc%
PmRec% = Mrec%
Psc% = Sc%
END IF
ELSE
top% = j% + 1
EXIT FOR
END IF
NEXT j%
IF top% <> 1 THEN
FOR j% = 1 TO (height% - top%) + 1
Disp$(j%) = Disp$(j% + top% - 1)
Disp$(j% + top% - 1) = STRING$(Ch.KeyLen, 32)
Mrtemp%(j%) = Mrtemp%(j% + top% - 1)
Mrtemp%(j% + top% - 1) = 0
Sctemp%(j%) = Sctemp%(j% + top% - 1)
Sctemp%(j% + top% - 1) = 0
NEXT j%
END IF
RETURN
END SUB